home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / docs / winer / chap11-8.bas < prev    next >
Encoding:
BASIC Source File  |  1992-05-13  |  5.1 KB  |  143 lines
  1. '*********** CHAP11-8.BAS - demonstrates reading file names to an array
  2.  
  3. 'Copyright (c) 1992 Ethan Winer
  4.  
  5. DEFINT A-Z
  6. DECLARE SUB LoadNames (FileSpec$, Array$(), Attribute%)
  7.  
  8. '$INCLUDE: 'REGTYPE.BI'
  9.  
  10. TYPE DTA                        'used by find first/next
  11.   Reserved  AS STRING * 21      'reserved for use by DOS
  12.   Attribute AS STRING * 1       'the file's attribute
  13.   FileTime  AS STRING * 2       'the file's time
  14.   FileDate  AS STRING * 2       'the file's date
  15.   FileSize  AS LONG             'the file's size
  16.   FileName  AS STRING * 13      'the file's name
  17. END TYPE
  18.  
  19. DIM SHARED DTAData AS DTA       'shared so LoadNames can
  20. DIM SHARED Registers AS RegType '  access them too
  21.  
  22.  
  23. DEF FnFileCount% (Spec$, Attribute)
  24.  
  25.   STATIC Count                   'make this private
  26.  
  27.   Registers.DX = VARPTR(DTAData) 'set new DTA address
  28.   Registers.DS = -1              'the DTA is in DGROUP
  29.   Registers.AX = &H1A00          'specify service 1Ah
  30.   CALL DOSInt(Registers)         'DOS set DTA service
  31.  
  32.   Count = 0                      'clear the counter
  33.   Spec$ = Spec$ + CHR$(0)        'make an ASCIIZ string
  34.   IF Attribute AND 16 THEN       'find directory names?
  35.     DirFlag = -1                 'yes
  36.   ELSE
  37.     DirFlag = 0                  'no
  38.   END IF
  39.  
  40.   Registers.DX = SADD(Spec$)     'the file spec address
  41.   Registers.DS = SSEG(Spec$)     'this is for BASIC PDS
  42.  'Registers.DS = -1              'this is for QuickBASIC
  43.   Registers.CX = Attribute       'assign the attribute
  44.   Registers.AX = &H4E00          'find first matching name
  45.  
  46.   DO
  47.     CALL DOSInt(Registers)                        'see if there's a match
  48.     IF Registers.Flags AND 1 THEN EXIT DO         'no more
  49.     IF DirFlag THEN                               'do they want directories?
  50.       IF ASC(DTAData.Attribute) AND 16 THEN       'is it a directory?
  51.         IF LEFT$(DTAData.FileName, 1) <> "." THEN 'filter "." and ".."
  52.           Count = Count + 1                       'increment the counter
  53.         END IF
  54.       END IF
  55.     ELSE
  56.       Count = Count + 1                           'they want regular files
  57.     END IF
  58.  
  59.     Registers.AX = &H4F00        'find next name
  60.   LOOP
  61.  
  62.   FnFileCount% = Count           'assign the function
  63.  
  64. END DEF
  65.  
  66.  
  67. REDIM Names$(1 TO 1)             'create a dynamic arrray
  68. Attribute = 19                   'this matches directories only
  69. Attribute = 39                   'this matches all files
  70.  
  71. INPUT "Enter a file specification: ", Spec$
  72. CALL LoadNames(Spec$, Names$(), Attribute)
  73.  
  74. FOR X = LEN(Spec$) TO 1 STEP -1  'isolate the drive/path
  75.   Temp = ASC(MID$(Spec$, X, 1))
  76.   IF Temp = 58 OR Temp = 92 THEN '":" or "\"
  77.     Path$ = LEFT$(Spec$, X)      'keep what precedes that
  78.     EXIT FOR                     'and we're all done
  79.   END IF
  80. NEXT
  81.  
  82. FOR X = 1 TO UBOUND(Names$)      'print the names
  83.   PRINT Path$; Names$(X)
  84. NEXT
  85.  
  86. PRINT
  87. IF LEN(Names$(1)) THEN           'if any were found
  88.   PRINT UBOUND(Names$); "matching file(s)"
  89. ELSE
  90.   PRINT "No files matched "; Spec$
  91. END IF
  92.  
  93. SUB LoadNames (FileSpec$, Array$(), Attribute) STATIC
  94.  
  95.   Spec$ = FileSpec$ + CHR$(0)               'make an ASCIIZ string
  96.   NumFiles = FnFileCount%(Spec$, Attribute) 'count the names
  97.   IF NumFiles = 0 THEN EXIT SUB             'exit if none
  98.   REDIM Array$(1 TO NumFiles)    'dimension the array
  99.  
  100.   IF Attribute AND 16 THEN       'find directory names?
  101.     DirFlag = -1                 'yes
  102.   ELSE
  103.     DirFlag = 0                  'no
  104.   END IF
  105.  
  106.   '---- The following code isn't strictly necessary because we
  107.   '     know that FnFileCount already set the DTA address.
  108.  'Registers.DX = VARPTR(DTAData) 'set new DTA address
  109.  'Registers.DS = -1              'the DTA in DGROUP
  110.  'Registers.AX = &H1A00          'specify service 1Ah
  111.  'CALL DOSInt(Registers)         'DOS set DTA service
  112.  
  113.   Registers.DX = SADD(Spec$)     'the file spec address
  114.   Registers.DS = SSEG(Spec$)     'this is for BASIC PDS
  115.  'Registers.DS = -1              'this is for QuickBASIC
  116.   Registers.CX = Attribute       'assign the attribute
  117.   Registers.AX = &H4E00          'find first matching name
  118.   Count = 0                      'clear the counter
  119.  
  120.   DO
  121.     CALL DOSInt(Registers)                        'see if there's a match
  122.     IF Registers.Flags AND 1 THEN EXIT DO         'no more
  123.     Valid = 0                                     'assume invalid
  124.     IF DirFlag THEN                               'do they want directories?
  125.       IF ASC(DTAData.Attribute) AND 16 THEN       'is it a directory?
  126.         IF LEFT$(DTAData.FileName, 1) <> "." THEN 'filter "." and ".."
  127.           Valid = -1                              'this name is valid
  128.         END IF
  129.       END IF
  130.     ELSE
  131.       Valid = -1                                  'they want regular files
  132.     END IF
  133.  
  134.     IF Valid THEN                                 'process the file if it
  135.       Count = Count + 1                           '  passed all the tests
  136.       Zero = INSTR(DTAData.FileName, CHR$(0))           'find the zero byte
  137.       Array$(Count) = LEFT$(DTAData.FileName, Zero - 1) 'assign the name
  138.     END IF
  139.     Registers.AX = &H4F00        'find next matching name service
  140.   LOOP
  141.  
  142. END SUB
  143.